perm filename DISP.F4[1,MUS]1 blob sn#079064 filedate 1973-12-22 generic text, type T, neo UTF8
00100		SUBROUTINE DISP(ZCAR,ZMOD,ZZI1,ZZI2)
00200		COMMON FREQ(3,0/50,50),FUNC(50),AMP(50),II(1),IJJ(3000)
00300	302	TYPE 303
00400	303	FORMAT(' TYPE 0 OR 1 FOR NO CH OR AMP FUNC'/)
00500		ACCEPT 304,IFUN
00600	304	FORMAT(I)
00700		GO TO (305,306),IFUN+1
00800	306	TYPE 310
00900	310	FORMAT(' NOW AMPLITUDE FUNCTION'/)
01000		CALL GEN(AMP)
01100		GO TO 305
01200	305	TYPE 308
01300	308	FORMAT(' TYPE 1 FOR ANOTHER FUN OR 0'/)
01400		ACCEPT 304,K
01500		IF(K.EQ.1)GO TO 302
01600		MIBASE=99999
01700		MIFREQ=-400
01800	309	TYPE 103
01900	103	FORMAT(' TYPE 0 FOR NO LINES OR N'/)
02000		ACCEPT 104,ND
02100	104	FORMAT (I)
02200		CALL DPYSET(1,IJJ,3000)
02300		CALL CLRPOG(1)
02400		CALL ALINE(-400,300,-200,300)
02500		CALL ALINE(-400,400,-400,300)
02600		CALL DPYBIG(2)
02700		CALL DPYTXT(-380,280,'AMP FUNCTION',3)
02800		CALL DPYTXT(-440,400,'1.0',1)
02900		IY=AMP(1)*100.+300.
03000		IX=-400
03100		CALL AIVECT(IX,IY)
03200		DO 401 I=2,50
03300		IX=IX+4
03400		IY=AMP(I)*100.+300.
03500	401	CALL AVECT(IX,IY)
03600		CALL ALINE(100,300,300,300)
03700		CALL ALINE(100,400,100,300)
03800		CALL DPYTXT(120,280,'INDEX FUNCTION',3)
03900		CALL DPYTXT(60,400,'IDX2',1)
04000		CALL DPYTXT(60,300,'IDX1',1)
04100		IY=AMP(1)*100.+300.
04200		IX=100
04300		CALL AIVECT(IX,IY)
04400		DO 402 I=2,50
04500		IY=FUNC(I)*100.+300.
04600		IX=IX+4
04700	402	CALL AVECT(IX,IY)
04702		CALL DPYBIG(3)
04704		MCAR='CAR='
04706		ENCODE(5,71,NCAR)MCAR
04708	71	FORMAT(A5)
04710		CALL DPYTXT(-400,-300,NCAR,1)
04712		XCAR=ZCAR
04714		ENCODE(5,72,XXCAR)XCAR
04716	72	FORMAT(F5.1)
04718		CALL DPYTXT(-360,-300,XXCAR,1)
04720		MCAR='MOD='
04722		ENCODE(5,71,NCAR)MCAR
04726		CALL DPYTXT(-400,-320,NCAR,1)
04728		XCAR=ZMOD
04730		ENCODE(5,72,XXCAR)XCAR
04734		CALL DPYTXT(-360,-320,XXCAR,1)
04736		MCAR='IDX1='
04738		ENCODE(5,71,NCAR)MCAR
04742		CALL DPYTXT(-400,-340,NCAR,1)
04744		XCAR=ZZI1
04746		ENCODE(5,72,XXCAR)XCAR
04750		CALL DPYTXT(-360,-340,XXCAR,1)
04752		MCAR='IDX2='
04754		ENCODE(5,71,NCAR)MCAR
04756		CALL DPYTXT(-400,-360,NCAR,1)
04758		XCAR=ZZI2
04760		ENCODE(5,72,XXCAR)XCAR
04762		CALL DPYTXT(-360,-360,XXCAR,1)
04900		CALL ALINE(-400,0,100,0)
05000		CALL ALINE(100,0,90,5)
05100		CALL ALINE(100,0,90,-5)
05200		CALL ALINE(-400,250,-400,0)
05300		CALL ALINE(-400,250,-395,240)
05400		CALL ALINE(-400,250,-405,240)
05500		CALL DPYTXT(-480,250,'Amp',1)
05600		CALL DPYBIG(2)
05700		CALL DPYTXT(-480,0,'0 Hz',1)
05800		CALL DPYBIG(3)
05900		CALL DPYTXT(115,0,'Time',1)
06000		IX=-400
06100		IY=-70
06200		M=10
06300		CALL DPYTXT(IX,IY,'F',1)
06400		IX=IX+M
06500		IY=IY-M
06600		CALL DPYTXT(IX,IY,'r',1)
06700		IX=IX+M
06800		IY=IY-M
06900		CALL DPYTXT(IX,IY,'e',1)
07000		IX=IX+M
07100		IY=IY-M
07200		CALL DPYTXT(IX,IY,'q',1)
07300		MAX=FREQ(1,50,1)
07400		DO 200 J=0,MAX
07500		KL=1
07600	50	IF(FREQ(1,J,KL).EQ.99999.)GO TO 100
07700	C	IF((FREQ(1,J,KL).EQ.0.0).AND.(FREQ(3,J,KL).EQ.0.0))GO TO 100
07800		IX=ABS(FREQ(1,J,KL))-400.
07900		ZZ=IX
08000		IY=(ZZ+400.)*(-1.)+250.*FREQ(2,J,KL)*AMP(1)
08100		BASE=(ZZ+400.)*(-1.)
08200		IBASE=BASE
08300		IF(MIBASE.GT.IBASE)MIBASE=IBASE
08400		CALL DPYBIG(2)
08500		IF(FREQ(3,J,KL).NE.0.0)GO TO 51
08600		CALL DPYTXT(IX-40,IBASE,'car',1)
08700		GO TO 60
08800	51	MFREQ=FREQ(1,J,KL)
08900		ENCODE(5,52,NFREQ)MFREQ
09000	52	FORMAT(I5)
09100		CALL DPYTXT(IX-60,IBASE,NFREQ,1)
09200		GO TO 60
09300	100	KL=KL+1
09400		IF(KL.GT.50)GO TO 30
09500		GO TO 50
09600	60	CALL AIVECT(IX,IBASE)
09700		IFREQ=IX
09800		IF(MIFREQ.LT.IFREQ)MIFREQ=IFREQ
09900		DO 61 NO=1,25
10000		CALL SVECT(5,0)
10100	61	CALL SIVECT(15,0)
10200		IF(KL.NE.1)IX=IX+(KL-1)*10
10300		CALL AIVECT(IX,IBASE)
10400		IF(IY.LE.IBASE)IY=(IABS(IY)-IABS(IBASE))+IBASE
10500		IF(FREQ(2,J,KL).NE.0.0)CALL AVECT(IX,IY)
10600	30	CONTINUE
10700		NC=1
10750		IFLIP=1
10800		DO 199 KZ=KL+1,50
10900		IF(KL.GT.50)GO TO 199
11000		IF(FREQ(1,J,KZ).EQ.99999.)GO TO 199
11100		IX=IX+10
11200		IY=FREQ(2,J,KZ)*250.*AMP(KZ)+BASE
11300		IF(IY.LE.IBASE)IY=(IABS(IY)-IABS(IBASE))+IBASE
11310		IF(FREQ(1,J,KZ).EQ.0.0)IFLIP=-IFLIP
11320		IF(IFLIP.GT.0)GO TO 2001
11330		CALL AIVECT(IX,IY)
11340		GO TO 2002
11400	2001	CALL AVECT(IX,IY)
11500	2002	IF(ND.EQ.0)GO TO 199
11600		IF(NC.LT.ND)GO TO 102
11700		CALL AVECT(IX,IBASE)
11800		CALL AIVECT(IX,IY)
11900	102	NC=NC+1
12000		IF(NC.GT.ND)NC=1
12100	199	CONTINUE
12200	200	CONTINUE
12300		MIFREQ=MIFREQ+10
12400		MIBASE=MIBASE-10
12500		CALL ALINE(-400,0,MIFREQ,MIBASE)
12600		CALL ALINE(MIFREQ,MIBASE,MIFREQ-2,MIBASE+10)
12700		CALL ALINE(MIFREQ,MIBASE,MIFREQ-10,MIBASE+4)
12800		CALL DPYOUT(1)
12900		TYPE 603
13000	603	FORMAT(' TYPE 0 TO FIN-1 TO CHNG AMP F-OR 2 VERT LINES'/)
13100		ACCEPT 304,N
13200		CALL HYDPOG(1)
13300		GO TO (302,309),N
13400		II(1)=IJJ(2)+2
13500		CALL SAVB(II)
13600		RETURN
13700		END